home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
tzap210.arc
/
SCOLOR.200
< prev
next >
Wrap
Text File
|
1985-09-08
|
7KB
|
159 lines
{**********************************************************************}
{* S C O L O R . I N C : Select Color from palette *}
{* *}
{* Separate this file into SCOLOR.200 *}
{**********************************************************************}
{----------------------------------------------------------------------}
{ S e l e c t _ C o l o r : Ask for Color and Return Attribute }
{----------------------------------------------------------------------}
{ Ask user to choose a color foreground and background and return the }
{ attribute. }
{ Input: Attribute at which to position the first Cursor }
{ Output: Atribute selection by the user or Zero }
{**********************************************************************}
Procedure Select_Color(Var Attr: byte) ;
Const
Arr_Up = 72 ;
Arr_Dn = 80 ;
Arr_Right = 77 ;
Arr_Left = 75 ;
Return = 13 ;
Esc = 27 ;
Var
Fieldwidth,
ColorMatrixX,ColorMatrixY,
Foreground
:integer;
ch :char;
Old_Attr,
Old_Text,
Old_background,
Chval :byte;
{----------------------------------------------------------------------}
{ B l i n k the Cursor Position On/Off }
{----------------------------------------------------------------------}
Procedure Blink_Off; { Turn off blinking }
Var
x,y :integer;
Begin
x := WhereX; y := WhereY; { Save old cursor position }
For I := x to x+FieldWidth-1 do
Begin
GotoXY(I,y);BlinkChar(Off);
end;
GotoXY(x,y); { Restore old cursor position }
End;
Procedure Blink_On; { Turn off blinking }
Var
x,y :integer;
Begin
x := WhereX; y := WhereY; { Save old cursor position }
For I := x to x+FieldWidth-1 do
Begin
GotoXY(I,y);BlinkChar(On);
end;
GotoXY(x,y); { Restore old cursor position }
End;
{----------------------------------------------------------------------}
{ Move_Right_Left_Up_Dn : Cursor Move Routines }
{----------------------------------------------------------------------}
Procedure Move_Right; { Move Cursor right one position}
Begin { Restore unblinking attributes }
Blink_Off; { to old cursor postion }
ColorMatrixX :=(ColorMatrixX + FieldWidth);
If ColorMatrixX > 16*Fieldwidth then ColorMatrixX := Fieldwidth;
GotoXY(ColorMatrixX,ColorMatrixY); { Move to new cursor postion and}
Blink_On; { set blinking attribute }
End; {Move_Right}
Procedure Move_Left; { Move Cursor Left one position }
Begin { Restore unblinking attributes }
Blink_Off; { to old cursor postion }
ColorMatrixX := ColorMatrixX - FieldWidth;
If (ColorMatrixX < FieldWidth) then
ColorMatrixX := FieldWidth*16;
GotoXY(ColorMatrixX,ColorMatrixY); { Move to new cursor postion and}
Blink_On; { set blinking attribute }
End; {Move_Left}
Procedure Move_Up; { Move up one Row }
Begin { Restore unblinking attributes }
Blink_Off; { to old cursor postion }
ColorMatrixY := ColorMatrixY - 1;
If ColorMatrixY < 4 then ColorMatrixY := 4+7;
GotoXY(ColorMatrixX,ColorMatrixY); { Move to new cursor postion and}
Blink_On; { set blinking attribute }
end; {Move_Up}
Procedure Move_Down; { Move Down one Row }
Begin { Restore unblinking attributes }
Blink_Off; { to old cursor postion }
ColorMatrixY := ColorMatrixY + 1;
If ColorMatrixY > 4+7 then colorMatrixY := 4;
GotoXY(ColorMatrixX,ColorMatrixY); { Move to new cursor postion and}
Blink_On; { set blinking attribute }
end; {Move_Down}
Procedure Selected; { Pass back selected attribute }
Begin
Blink_Off; { Turn off any linking }
Get_Abs_Cursor(x,y);
Attr := { Get old Cursor attributes }
Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
End; {Procedure Selected }
{-----------------------------------------------------------------------}
{ M a i n P r o c e d u r e : Select Color and Return Attribute }
{-----------------------------------------------------------------------}
Begin {Select_Color}
Old_Attr := Attr; { Save old Attributes }
Old_Text := Attr and $0F;
Old_background := Attr shr 4;
Get_Abs_Cursor(x,y); { Find Cursor and make }
MkWin(4,y,74,y+16,White); { a window/Set Color }
Fieldwidth := 4; { Colors Display Width }
TextColor(Old_Text);
clrscr;
GotoXY(14,1); write('* * * Move Cursor to Select Colors * * *');
GotoXY(14,2); write('Enter ');
TextColor(Old_Text+Blink);Write('[Return]');
TextColor(Old_Text);Write(' to select -- ');
TextColor(Old_Text+Blink); Write('[Esc]');
TextColor(Old_Text); Writeln(' to Ignore');
ColorMatrixX := WhereX; ColorMatrixY := WhereY;
For Background:=0 to 7 do { Background Color attributes }
Begin
for Foreground:=0 to 15 do { Foreground Color attributes }
begin { Display the Color matrix }
gotoxy(Fieldwidth*(Foreground+1),Background+4); { display posn }
textcolor(Foreground);
textbackground(Background);
write(Foreground:Fieldwidth-1);
end; { Forground}
Writeln;
end; { Background }
{ Put Cursor at Old Attriute }
ColorMatrixX := Fieldwidth * (Old_Text)+Fieldwidth;
ColorMatrixY := 4 + (Old_background);
GotoXY(ColorMatrixX,ColorMatrixY); { Position the Cursor }
Chval := 0;
Repeat {until Chval=Return|Esc key} { Get an attribute selection }
Chval := Keyin; { Wait for user key }
Case Chval of
Arr_Right : Move_Right;
Arr_Left : Move_Left;
Arr_Up : Move_Up;
Arr_Dn : Move_Down;
Return : Selected;
Esc :
else Beep(600);
end; {case Chval}
Until (Chval=Return) or (Chval=Esc);
RmWin; { Remove the Color Window }
end; {Select_Color}
{.......................................................................}